home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.002 / stk-3 / STk-3.1 / STklos / Examples / E0.stklos next >
Encoding:
Text File  |  1995-01-01  |  3.6 KB  |  94 lines
  1. ;;;;
  2. ;;;; E x a m p l e 0 .  s t k
  3. ;;;;
  4. ;;;; Copyright (C) 1993,1994,1995 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  5. ;;;; 
  6. ;;;; Permission to use, copy, and/or distribute this software and its
  7. ;;;; documentation for any purpose and without fee is hereby granted, provided
  8. ;;;; that both the above copyright notice and this permission notice appear in
  9. ;;;; all copies and derived works.  Fees for distribution or use of this
  10. ;;;; software or derived works may only be charged with express written
  11. ;;;; permission of the copyright holder.  
  12. ;;;; This software is provided ``as is'' without express or implied warranty.
  13. ;;;;
  14. ;;;;           Author: Erick Gallesio [eg@kaolin.unice.fr]
  15. ;;;;    Creation date:  5-Aug-1994 10:30
  16. ;;;; Last file update: 27-Nov-1994 15:18 
  17.  
  18. ;;;; This file desmonstates the use of composite objects. First we define the class
  19. ;;;; <Car> and <Caravan>.
  20.  
  21. (define-class <Car> ()
  22.   ((power  :init-keyword :power  :accessor power)
  23.    (driver :init-keyword :driver :accessor driver)
  24.    (color  :init-keyword :color  :accessor color)))
  25.  
  26. (define-class <Caravan> ()
  27.   ((capacity :init-keyword :capacity :accessor capacity)
  28.    (color    :init-keyword :color    :accessor color)))
  29.  
  30.  
  31. ;;;; Hereafter is a first definition of <Camping-car>. Note that the color slot 
  32. ;;;; is propagated to the color slot of the "house" and "car" components of the
  33. ;;;; camping car. Note the use of the :metaclass option for managing :propagated
  34. ;;;; slots.
  35.  
  36. (define-class <Camping-car>()
  37.   ((car     :getter car-of) ;; Don't redefine CAR!!!!
  38.    (house   :getter house)
  39.    (color   :init-keyword :color :accessor color
  40.         :allocation :propagated :propagate-to (car house)))
  41.   :metaclass <Composite-metaclass>)
  42.  
  43. ;;;; Defining a composite widget requires to define a initialize method.
  44. (define-method initialize ((self <Camping-car>) initargs)
  45.   (slot-set! self 'car   (make <Car>))
  46.   (slot-set! self 'house (make <Caravan>))
  47.   (next-method))
  48.          
  49. ;;;; And now we can define a camping-car
  50. (define cc (make <Camping-car> :color "red"))
  51. (color cc)              ; ===> "red"
  52. (color (car-of cc))        ; ===> "red"
  53. (color (house cc))        ; ===> "red"
  54. (slot-set! cc 'color "yellow")  ; other writing: (set! (color cc) "yellow")
  55. (color cc)              ; ===> "yellow"
  56. (color (car-of cc))        ; ===> "yellow"
  57. (color (house cc))        ; ===> "yellow"
  58. ;;;; Of course, color of the house coud be different and we can do
  59. (set! (color (house cc)) "green")
  60. (color cc)              ; ===> "yellow"
  61. (color (car-of cc))        ; ===> "yellow"
  62. (color (house cc))        ; ===> "green"
  63.  
  64.  
  65. ;;;; Getting or setting the power of the car with this first definition
  66. ;;;; is a little bit messy. We have to do
  67. ;;;;        (set! (power (car-of cc)) 10)
  68. ;;;; To avoid this we can use a "power" propagated slot which will propagate
  69. ;;;; to the "car" component. Another way consists to use inheritance. 
  70. ;;;;
  71. ;;;; Note: Purists will tell you that inheritance permits object specialization
  72. ;;;; and NOT object composition. However, we can use it here to avoid the 
  73. ;;;; definition of propagated slots.
  74. ;;;;
  75. ;;;; Here is the new definition of <Camping-car>.
  76.  
  77. (define-class <Camping-car>(<Car>)
  78.   ((car     :getter car-of) ;; Don't redefine CAR!!!!
  79.    (house   :getter house)
  80.    (color   :init-keyword :color :accessor color
  81.         :allocation :propagated :propagate-to (car house)))
  82.   :metaclass <Composite-metaclass>)
  83.  
  84. ;;;; initialize is unmodified (but we have to redefine it since <Camping-car>
  85. ;;;; was changed.
  86. (define-method initialize ((self <Camping-car>) initargs)
  87.   (slot-set! self 'car   (make <Car>))
  88.   (slot-set! self 'house (make <Caravan>))
  89.   (next-method))
  90.  
  91. ;;;; Now we can do
  92.  
  93. (define cc2 (make <Camping-Car> :color "brown" :driver "Joe" :power 10))
  94.